(defprop trans1 (
 TRANSFORM
 TRANSA
 TRANSB
 SIDE
 INST
 ISVAR
)trans1fns)


(DEFUN TRANSFORM (E R DONE) 
       (COND ((MEMBER E DONE) E)
	     (T ((LAMBDA (W) (COND ((EQ W E)
				    (COND ((ATOM E) E)
					  (T ((LAMBDA (X Y) 
					       (COND
						((AND (EQ X (CAR E))
						      (EQ Y (CDR E)))
						 (SIDE
						  E
						  (SETQ DONE
							(CONS E
							      DONE))))
						(T (TRANSFORM (CONS X Y)
     							      R
							      DONE))))
					      (TRANSFORM (CAR E)
							 R
							 DONE)
					      (TRANSFORM (CDR E)
							 R
							 DONE)))))
				   (T (TRANSFORM W R DONE))))
		 (TRANSA E R)))))

(DEFUN TRANSA (E R) 
       (COND ((NULL R) E)
	     (T ((LAMBDA (W) (COND ((EQ W E) (TRANSA E (CDR R)))
				   (T W)))
		 (TRANSB E (CAR R))))))

(DEFUN TRANSB (E RULE) 
       ((LAMBDA (W) (COND ((EQ W 'NO) E)
			  (T (COND (PRINT_INST (PRINT E) (PRINT RULE) (PRINT W) (TERPRI)))
			     (SUBLIS W (CADR RULE)))))
	(INST E (CAR RULE) NIL)))

(DEFUN SIDE (X Y) X)

(DEFUN INST (E PAT ML) 
  (COND ((EQ ML (QUOTE NO)) ML) 
	((ATOM PAT) 
	  (COND ((ISVAR PAT)
		  ((LAMBDA (W) (COND ((NULL W) (CONS (CONS PAT E) ML))
				     ((EQUAL (CDR W) E) ML) 
				     (T (QUOTE NO)))) 
		   (ASSOC PAT ML)))
		((EQ PAT E) ML) 
		(T (QUOTE NO)))) 
	((ATOM E) (QUOTE NO))
	(T (INST (CDR E) (CDR PAT) (INST (CAR E) (CAR PAT) ML)))))

(DEFUN ISVAR (V) (MEMQ V '(X Y Z)))
(SETQ PRINT_INST NIL)

(SETQ R1 '(((PLUS X . Y) (PLUSA X (PLUS . Y)))
	   ((PLUSA 0 . X) (PLUSA . X))
	   ((PLUS) (PLUSB))
	   ((PLUSA X (PLUSB . Y)) (PLUSB X . Y))
	   ((PLUSA (PLUSB . X)) (PLUSB . X))))

(SETQ R2 '(((PLUS X . Y) (PLUSA X (PLUS . Y)))
	   ((PLUS) 0)
	   ((PLUSA 0 . X) (PLUSA . X))
	   ((PLUSA) 0)
	   ((PLUSA X 0) X)
	   ((PLUSA X) X)
	   ((PLUSA (PLUSA X . Y) . Z) (PLUSA X (PLUSA . Y) . Z))
	   ((TIMES X . Y) (TIMESA X (TIMES . Y)))
	   ((TIMES) 1)
	   ((TIMESA 1 . X) (TIMESA . X))
	   ((TIMESA) 1)
	   ((TIMESA X 1) X)
	   ((TIMESA X) X)
	   ((TIMESA (TIMESA X . Y) . Z) (TIMESA X (TIMESA . Y) . Z))
	   ((TIMES 0 . X) 0)
	   ((TIMESA 0 . X) 0)))
;;; Sample run


;;;(TRANSFORM '(PLUS A 0) R1 NIL)
;;;(PLUSB A)